home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
PRUS101.ZIP
/
FCONDRV.INC
< prev
next >
Wrap
Text File
|
1994-12-20
|
13KB
|
515 lines
{ FCONDRV.INC - include file to partially clone CRT's functions for usage by
the PRUSSG unit FCRT
***************************************************************************
RELEASE 1.08 - as first contained in the file PRUS101.LZH
by Paul Schubert, 2:244/1181.18, GERMANY
--------------------------------------------
organized for Fido's PASCAL related echoes
--------------------------------------------
06/21/1994 to --/--/---- by Paul Schubert, 2:244/1181.18, GERMANY
As far as third party copyrights are not violated this
source code is hereby placed to the public domain. Use
it whatever way you want, but use AT YOUR OWN RISK.
In case you should modify the source rather send your
modifications to the unit's current organizer (see above for
NM address) than to spread it on your own. This will help to
keep the unit updated and grant a certain standard to all
other users as well.
The unit is currently still under work. So it might greatly
benefit of your participation.
Those who contributed to the following piece of source,
listed in alphabethical order:
================================================================
Orazio Czerwenka, Paul Schubert ...
================================================================
YOUR NAME WILL APPEAR HERE IF YOU CONTRIBUTE USEFUL SOURCE.
Credits in your own programs are as welcome as unnecessary.
***************************************************************************}
TYPE CPOSTYPE = RECORD X,Y : BYTE END;
WORDARRAY = ARRAY[0..$FFF] OF WORD;
PWORDARRAY = ^WORDARRAY;
SOF = RECORD O,S : WORD END;
WINDOWPTR = ^WINDOWTYP;
WINDOWTYP = RECORD
NXT : WINDOWPTR;
X,Y,W,H : BYTE;
DATEN : ARRAY[0..0] OF BYTE;
END;
CURSORTYPE = ARRAY[0..7] OF CPOSTYPE;
CONST WINDPTR : WINDOWPTR = NIL;
VAR
CURSOR : CURSORTYPE ABSOLUTE $40:$50;
LINEWIDTH : WORD;
WINDWIDTH : BYTE;
WINDHEIGHT : BYTE;
WMI,WMA : ARRAY[0..7] OF WORD;
PROCEDURE STI; INLINE($FB);
PROCEDURE CLI; INLINE($FA);
PROCEDURE PUSHF; INLINE($9C);
PROCEDURE POPF; INLINE($9D);
PROCEDURE SETPORT(PORTADR:WORD;INDEX,DAT:BYTE);
BEGIN
PUSHF;
CLI;
PORT[PORTADR] := INDEX;
PORT[PORTADR+1] := DAT;
POPF;
END;
FUNCTION CURSORPOINTER:POINTER;
BEGIN
CURSORPOINTER := PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE
+(WORD(MaxX)*CURSOR[ACTIVEVIDEOPAGE].Y
+CURSOR[ACTIVEVIDEOPAGE].X) SHL 1);
END; { CURSORPOINTER }
FUNCTION SCREENPOINTER:POINTER;
BEGIN
SCREENPOINTER := PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE);
END; { SCREENPOINTER }
FUNCTION WINDOWPOINTER:POINTER;
BEGIN
WINDOWPOINTER := PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE
+LINEWIDTH*HI(WINDMIN)
+(LO(WINDMIN) SHL 1));
END; { WINDOWPOINTER }
PROCEDURE FILLWORD(START:PWORDARRAY;ANZAHL,DATEN:WORD);
ASSEMBLER;
ASM
LES DI,START
MOV CX,ANZAHL
MOV AX,DATEN
CLD
REP STOSW
END; { FILLWORD }
{
FCRT.FILLWORD: ASM
cs:00B8 55 push bp
cs:00B9 89E5 mov bp,sp
FCRT.FCONDRV.INC.107: LES DI,START
cs:00BB C47E0A les di,[bp+0A]
FCRT.FCONDRV.INC.108: MOV CX,ANZAHL
cs:00BE 8B4E08 mov cx,[bp+08]
FCRT.FCONDRV.INC.109: MOV AX,DATEN
cs:00C1 8B4606 mov ax,[bp+06]
FCRT.FCONDRV.INC.110: CLD
cs:00C4 FC cld
FCRT.FCONDRV.INC.111: REP STOSW
cs:00C5 F3AB rep stosw
FCRT.FCONDRV.INC.112: END;
cs:00C7 C9 leave
cs:00C8 CA0800 retf 0008
}
PROCEDURE SCROLL;
VAR Y : BYTE;
P1,P2 : POINTER;
R : REGISTERS;
BEGIN
IF DIRECTVIDEO THEN BEGIN
P1 := WINDOWPOINTER;
P2 := P1; INC(SOF(P2).O,LINEWIDTH);
FOR Y := SUCC(HI(WINDMIN)) TO SUCC(HI(WINDMAX)) DO BEGIN
MOVE(P2^,P1^,WINDWIDTH SHL 1);
P1 := P2;
INC(SOF(P2).O,LINEWIDTH);
END; { NEXT Y }
DEC(SOF(P1).O,LINEWIDTH);
FILLWORD(P1,WINDWIDTH,WORD(TEXTATTR) SHL 8 + $20);
END ELSE BEGIN
R.AH := 5;
R.AL := ACTIVEVIDEOPAGE;
INTR($10,R);
R.AX := $601;
R.BH := TEXTATTR;
R.CX := WINDMIN;
R.DX := WINDMAX;
INTR($10,R);
END;
END; { SCROLL }
{
SCROLLABSOLUTE WIRD NIRGENDS GEBRAUCHT
}
PROCEDURE SCROLLABSOLUTE;
VAR R : REGISTERS;
BEGIN
IF DIRECTVIDEO THEN BEGIN
MOVE(MEM[VIDEORAM:VideoPageSize*ACTIVEVIDEOPAGE+LINEWIDTH],
SCREENPOINTER^,
LINEWIDTH*MaxY);
FILLWORD(PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE+
MaxY*LINEWIDTH),
MaxX,
WORD(TEXTATTR) SHL 8 + $20);
END ELSE BEGIN
R.AH := 5;
R.AL := ACTIVEVIDEOPAGE;
INTR($10,R);
R.AX := $601;
R.BH := TEXTATTR;
R.CX := 0;
R.DH := SUCC(MaxY);
R.DL := MaxX;
INTR($10,R);
END;
END; { SCROLLABSOLUTE }
PROCEDURE WINDOW(x,y,xx,yy:BYTE);
BEGIN
IF (WHEREX < x) OR (WHEREY < y) OR (WHEREX > xx) OR (WHEREY > yy)
THEN GOTOXYABSOLUTE(x,y);
WINDMIN := PRED(y) SHL 8 + PRED(x);
WINDMAX := PRED(yy) SHL 8 + PRED(xx);
WMI[ACTIVEVIDEOPAGE] := WINDMIN;
WMA[ACTIVEVIDEOPAGE] := WINDMAX;
WINDWIDTH := SUCC(xx-x);
WINDHEIGHT := SUCC(yy-y);
END; { WINDOW }
PROCEDURE PUSHWINDOW;
VAR YY,WID : WORD;
OLDP : WINDOWPTR;
DATP,VIDP : POINTER;
BEGIN
OLDP := WINDPTR;
WID := WINDWIDTH SHL 1;
GETMEM(WINDPTR,WID*WINDHEIGHT+SIZEOF(WINDOWTYP));
WITH WINDPTR^ DO BEGIN
NXT := OLDP;
X := LO(WINDMIN);
Y := HI(WINDMIN);
W := WID;
H := WINDHEIGHT;
DATP := @WINDPTR^.DATEN;
VIDP := WINDOWPOINTER;
FOR YY := Y TO PRED(Y+H) DO BEGIN
MOVE(VIDP^,DATP^,W);
INC(SOF(DATP).O,W);
INC(SOF(VIDP).O,LINEWIDTH);
END; { NEXT Y }
END; { WITH }
END; { PUSHWINDOW }
PROCEDURE POPWINDOW;
VAR YY : WORD;
OLDP : WINDOWPTR;
DATP,VIDP : POINTER;
BEGIN
IF WINDPTR = NIL THEN EXIT;
WITH WINDPTR^ DO BEGIN
OLDP := NXT;
DATP := @WINDPTR^.DATEN;
VIDP := PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE+(Y * MaxX + X) SHL 1);
FOR YY := Y TO PRED(Y+H) DO BEGIN
MOVE(DATP^,VIDP^,W);
INC(SOF(DATP).O,W);
INC(SOF(VIDP).O,LINEWIDTH);
END; { NEXT Y }
FREEMEM(WINDPTR,W*H+SIZEOF(WINDOWTYP));
END; { WITH }
WINDPTR := OLDP;
END; { POPWINDOW }
PROCEDURE MOVECURSOR;
VAR I : WORD;
BEGIN
I := VideoPageSize * ACTIVEVIDEOPAGE +
WORD(MaxX)*CURSOR[ACTIVEVIDEOPAGE].Y+
CURSOR[ACTIVEVIDEOPAGE].X;
SETPORT(CRTC,$E,HI(I));
SETPORT(CRTC,$F,I);
END; { MOVECURSOR }
PROCEDURE GOTOXYABSOLUTE(X,Y:BYTE);
BEGIN
CURSOR[ACTIVEVIDEOPAGE].X := PRED(X);
CURSOR[ACTIVEVIDEOPAGE].Y := PRED(Y);
MOVECURSOR;
END; { GOTOXYABSOLUTE }
PROCEDURE GOTOXY(X,Y:BYTE);
BEGIN
CURSOR[ACTIVEVIDEOPAGE].X := PRED(X)+LO(WINDMIN);
CURSOR[ACTIVEVIDEOPAGE].Y := PRED(Y)+HI(WINDMIN);
MOVECURSOR;
END; { GOTOXY }
PROCEDURE CLRSCRABSOLUTE;
VAR R : REGISTERS;
BEGIN
IF DIRECTVIDEO THEN BEGIN
GOTOXYABSOLUTE(1,1);
FILLWORD(SCREENPOINTER,VideoPageSize SHR 1,
WORD(TEXTATTR) SHL 8 + $20);
END ELSE BEGIN
R.AH := 5;
R.AL := ACTIVEVIDEOPAGE;
INTR($10,R);
R.AX := $600;
R.BH := TEXTATTR;
R.CX := 0;
R.DH := SUCC(MaxY);
R.DL := MaxX;
INTR($10,R);
END;
END; { CLRSCRABSOLUTE }
PROCEDURE CLRSCR;
VAR Y,AW : WORD;
P1 : POINTER;
VAR R : REGISTERS;
BEGIN
GOTOXY(1,1);
IF DIRECTVIDEO THEN BEGIN
P1 := WINDOWPOINTER;
AW := WORD(TEXTATTR) SHL 8 + $20;
FOR Y := HI(WINDMIN) TO HI(WINDMAX) DO BEGIN
FILLWORD(P1,WINDWIDTH,AW);
INC(SOF(P1).O,LINEWIDTH);
END; { NEXT Y }
END ELSE BEGIN
R.AH := 5;
R.AL := ACTIVEVIDEOPAGE;
INTR($10,R);
R.AX := $600;
R.BH := TEXTATTR;
R.CX := WINDMIN;
R.DX := WINDMAX;
INTR($10,R);
END;
END; { CLRSCR }
PROCEDURE CLREOL;
VAR R : REGISTERS;
BEGIN
IF DIRECTVIDEO THEN BEGIN
FILLWORD(CURSORPOINTER,
LO(WINDMAX)-WHEREXABSOLUTE + 2,
WORD(TEXTATTR) SHL 8 + $20
);
END ELSE BEGIN
R.AX := $920;
R.BH := ACTIVEVIDEOPAGE;
R.BL := TEXTATTR;
R.CX := LO(WINDMAX)-WHEREXABSOLUTE + 2;
INTR($10,R);
END;
END; { CLREOL }
PROCEDURE CLREOS;
VAR Y,AW : WORD;
P1 : POINTER;
R : REGISTERS;
BEGIN
P1 := PTR(VIDEORAM,VideoPageSize*ACTIVEVIDEOPAGE
+WHEREYABSOLUTE*LINEWIDTH + LO(WINDMIN) SHL 1);
AW := WORD(TEXTATTR) SHL 8 + $20;
CLREOL;
IF DIRECTVIDEO THEN BEGIN
FOR Y := WHEREYABSOLUTE TO HI(WINDMAX) DO BEGIN
FILLWORD(P1,WINDWIDTH,AW);
INC(SOF(P1).O,LINEWIDTH);
END; { NEXT Y }
END ELSE BEGIN
Y := WHEREYABSOLUTE;
IF Y < HI(WINDMAX) THEN BEGIN
R.AH := 5;
R.AL := ACTIVEVIDEOPAGE;
INTR($10,R);
R.AH := $6;
R.AL := Hi (WindMax) - y + 1;
R.BH := TEXTATTR;
R.CH := Y;
R.CL := LO(WINDMIN);
R.DX := WINDMAX;
INTR($10,R);
END;
END;
END; { CLREOS }
FUNCTION WHEREXABSOLUTE:BYTE;
BEGIN
WHEREXABSOLUTE := SUCC(CURSOR[ACTIVEVIDEOPAGE].X);
END; { WHEREXABSOLUTE }
FUNCTION WHEREYABSOLUTE:BYTE;
BEGIN
WHEREYABSOLUTE := SUCC(CURSOR[ACTIVEVIDEOPAGE].Y);
END; { WHEREYABSOLUTE }
FUNCTION WHEREX:BYTE;
BEGIN
WHEREX := SUCC(CURSOR[ACTIVEVIDEOPAGE].X)-LO(WINDMIN);
END; { WHEREX }
FUNCTION WHEREY:BYTE;
BEGIN
WHEREY := SUCC(CURSOR[ACTIVEVIDEOPAGE].Y)-HI(WINDMIN);
END; { WHEREY }
FUNCTION COUT(VAR F:TEXTREC):WORD;
VAR I,CW : WORD;
CP : CPOSTYPE;
WPTR : ^WORD;
CPTR : ^BYTE;
R : REGISTERS;
PROCEDURE LINEFEED;
BEGIN
IF CP.Y < HI(WINDMAX) THEN BEGIN
INC(CP.Y);
END ELSE BEGIN
SCROLL;
END;
CURSOR[ACTIVEVIDEOPAGE] := CP;
WPTR := CURSORPOINTER;
END; { LINEFEED }
BEGIN { COUT }
WITH F DO BEGIN
IF BUFPOS > 0 THEN BEGIN
CP := CURSOR[ACTIVEVIDEOPAGE];
WPTR := CURSORPOINTER;
CPTR := POINTER(BUFPTR);
CW := WORD(TEXTATTR) SHL 8;
{---
this is the lowest level output routine :
BUFPTR^ contains BUFPOS chars for output
}
FOR I := 0 TO PRED(BUFPOS) DO BEGIN
CASE BUFPTR^[I] OF
^G : BEGIN { DAS SOLL PIEPSEN }
R.AX := $E07;
INTR($10,R);
END;
^M : BEGIN
CP.X := LO(WINDMIN);
WPTR := CURSORPOINTER;
END;
^J : LINEFEED;
ELSE
IF DIRECTVIDEO THEN BEGIN
WPTR^ := CW OR CPTR^;
INC(SOF(WPTR).O,2);
END ELSE BEGIN
R.AH := 9;
R.AL := CPTR^;
R.BH := ACTIVEVIDEOPAGE;
R.BL := TEXTATTR;
R.CX := 1;
INTR($10,R);
END;
INC(SOF(CPTR).O);
IF CP.X < (LO(WINDMAX)) THEN BEGIN
INC(CP.X);
END ELSE BEGIN
CP.X := LO(WINDMIN);
LINEFEED;
END;
IF NOT DIRECTVIDEO THEN CURSOR[ACTIVEVIDEOPAGE] := CP;
END; { CASE }
END; { NEXT I }
{---}
BUFPOS := 0;
CURSOR[ACTIVEVIDEOPAGE] := CP;
MOVECURSOR;
END; { IF BUFPOS > 0 }
END; { WITH F }
COUT := 0;
END; { COUT }
FUNCTION COPEN(VAR F:TEXTREC):WORD;
BEGIN
F.MODE := FMOUTPUT;
COPEN := 0;
END; { COPEN }
FUNCTION CCLOSE(VAR F:TEXTREC):WORD;
BEGIN
F.MODE := FMCLOSED;
CCLOSE := 0;
END; { CCLOSE }
PROCEDURE ASSIGNFCRT(VAR F:TEXT);
BEGIN
WITH TEXTREC(F) DO BEGIN
MODE := FMCLOSED;
OPENFUNC := @COPEN;
FLUSHFUNC := @COUT;
CLOSEFUNC := @CCLOSE;
INOUTFUNC := @COUT;
BUFEND := 0;
BUFPOS := 0;
BUFPTR := @BUFFER;
NAME[0] := #0;
END;
END; { ASSIGNFCRT }
PROCEDURE REINITFCONDRV;
BEGIN
CRTC := MEMW[$40:$63];
LINEWIDTH := MaxX SHL 1;
WINDMAX := WORD(PRED(MaxY)) SHL 8 + PRED(MaxX);
WINDMIN := 0;
WINDWIDTH := SUCC(WindMax AND $FF);
WINDHEIGHT := SUCC((WindMax SHR 8) AND $FF);
FILLWORD(@WMI,8,WINDMIN);
FILLWORD(@WMA,8,WINDMAX);
END; { REINITCRT }